home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d12
/
vol6n20.arc
/
PROFIL.ARC
/
INVOKE.PRF
< prev
next >
Wrap
Text File
|
1987-10-31
|
8KB
|
220 lines
{ This is Kim Kokonnen's INVOKE.PAS, stripped of features not needed here. }
{ If you really want to know how it works, download the full version from DL4.}
const
NewStackSize = 1700; {Turbo Stack size (bytes) to keep while in DOS shell (>700)}
StackBufferSize = 512; {Bytes in DOS stack buffer}
var
TopOfStack : Integer; { used by INVOKE }
StackBuffer : array[1..StackBufferSize] of Byte;
StackSeg : Integer;
StackPtr : Integer;
NewStackSeg : Integer;
NewStackPtr : Integer;
ParasToKeep : Integer;
ParasWeHave : Integer;
ParasForDos : Integer;
ExecStatus : Integer;
CommandStr : string255 ;
I : integer ;
function StackPointer : Integer;
{-Return the stack pointer at the point of the call}
begin
inline(
$89/$E0/ {MOV AX,SP}
$05/$08/$00/ {ADD AX,0008}
$89/$EC/ {MOV SP,BP}
$5D/ {POP BP}
$C2/$02/$00 {RET 0002}
);
end; {StackPointer}
procedure Error(error_num : integer );
const
{ this array defines the error messages given in response to various
DOS errors. The messages that just indicate the error number shouldn't
occur. The text is included because it's space is free. (In fact,
errors 10 and 11 shouldn't occur either.) }
ErrorMsg : array[1..11] of string[30] =
( 'Error 1.',
'Can''t find file ', { 2 }
'Error 3.',
'Error 4.',
'Error 5.',
'Error 6.',
'Memory control blocks damaged.', { 7 }
'Not enough memory to load ', { 8 }
'Error 9.',
'Bad environment.', { 10 }
'Improper format for EXEC.' ) ; { 11 }
begin
if ((error_num >= 1) and (error_num <= 11)) then
begin
FastWrite( ErrorMsg[error_num], 23, 1, EmphAttr ) ;
if ((error_num = 2) or (error_num = 8)) then
FastWrite( CommandStr, 23, Length(ErrorMsg[error_num])+2, EmphAttr ) ;
end
else FastWrite( 'Error in Invoke.', 23, 1, EmphAttr ) ;
end; {Error}
procedure SetBlock(paras : Integer);
{-Free up some memory above this program for a DOS shell}
var
regs : Registers;
begin {SetBlock}
with regs do begin
Ah := $4A;
Es := CSeg;
Bx := paras;
MsDos(regs);
if Odd(Flags) then
Error(ax);
end;
end; {SetBlock}
procedure Invoke(command : String255);
function SubProcess(CommandLine : String255) : Integer;
{-From Bela Lubkin's EXEC.PAS}
const
SSSave : Integer = 0;
SPSave : Integer = 0;
var
regs : Registers;
FCB1, FCB2 : array[0..36] of Byte;
PathName : String255;
CommandTail : String255;
ParmTable : record
EnvSeg : Integer;
ComLin : ^Integer;
FCB1Pr : ^Integer;
FCB2Pr : ^Integer;
end;
RegsFlags : Integer;
begin
if Pos(' ', CommandLine) = 0 then begin
PathName := CommandLine+#0;
CommandTail := ^M;
end else begin
PathName := Copy(CommandLine, 1, Pred(Pos(' ', CommandLine)))+#0;
CommandTail := Copy(CommandLine, Pos(' ', CommandLine), 255)+^M;
end;
CommandTail[0] := Pred(CommandTail[0]);
with regs do begin
FillChar(FCB1, SizeOf(FCB1), 0);
Ax := $2901;
Ds := Seg(CommandTail[1]);
Si := Ofs(CommandTail[1]);
Es := Seg(FCB1);
Di := Ofs(FCB1);
MsDos(regs); { Create FCB 1 }
FillChar(FCB2, SizeOf(FCB2), 0);
Ax := $2901;
Es := Seg(FCB2);
Di := Ofs(FCB2);
MsDos(regs); { Create FCB 2 }
with ParmTable do begin
EnvSeg := Seg( EnvStr^ );
ComLin := Addr(CommandTail);
FCB1Pr := Addr(FCB1);
FCB2Pr := Addr(FCB2);
end;
inline(
$8D/$96/PathName/$42/ { <DX>:=Ofs(PathName[1]); }
$8D/$9E/ParmTable/ { <BX>:=Ofs(ParmTable); }
$B8/$00/$4B/ { <AX>:=$4B00; }
$1E/$55/ { Save <DS>, <BP> }
$16/$1F/ { <DS>:=Seg(PathName[1]); }
$16/$07/ { <ES>:=Seg(ParmTable); }
$2E/$8C/$16/SSSave/ { Save <SS> in SSSave }
$2E/$89/$26/SPSave/ { Save <SP> in SPSave }
$FC/ { CLD}
$FA/ { Disable interrupts }
$CD/$21/ { Call MS-DOS }
$FA/ { Disable interrupts }
$2E/$8B/$26/SPSave/ { Restore <SP> }
$2E/$8E/$16/SSSave/ { Restore <SS> }
$FB/ { Enable interrupts }
$5D/$1F/ { Restore <BP>,<DS> }
$9C/$8F/$86/RegsFlags/ { RegsFlags:=<CPU flags>}
$89/$86/regs); { Regs.AX:=<AX>; }
if Odd(RegsFlags) then
SubProcess := Ax
else
SubProcess := 0;
end;
end; {SubProcess}
begin {Invoke}
{Save current stack seg and ptr}
inline(
$8C/$D0/ {MOV AX,SS}
$A3/StackSeg/ {MOV stackseg,AX}
$89/$26/StackPtr {MOV stackptr,SP}
);
{The new lower stack goes above the "high water mark" of the heap }
{Heap fragmentation may cause HeapPtr to be higher than you expect}
NewStackSeg := Succ(Seg(HeapPtr^));
NewStackPtr := NewStackSize;
{Current DOS memory allocation read from memory control block}
ParasWeHave := MemW[Pred(CSeg):3];
ParasToKeep := Succ(NewStackSeg-CSeg)+Succ(NewStackSize shr 4);
ParasForDos := ParasWeHave-ParasToKeep;
{See if enough stack buffer to store current Turbo stack}
if succ(TopOfStack-StackPtr) > StackBufferSize then
begin
FastWrite( 'Insufficient memory for internal stack buffer.', 23, 1, EmphAttr ) ;
exit ;
end;
{Build the command string}
Commandstr := command ;
ClrScr;
{Copy the top of the stack to a buffer}
Move(Mem[StackSeg:StackPtr], StackBuffer, succ(TopOfStack-StackPtr));
{Lower stack}
inline(
$FA/ {CLI }
$A1/NewStackSeg/ {MOV AX,newstackseg}
$8E/$D0/ {MOV SS,AX}
$8B/$26/NewStackPtr/ {MOV SP,newstackptr}
$FB {STI }
);
{Deallocate memory}
SetBlock(ParasToKeep);
{Run the program}
ExecStatus := SubProcess(Commandstr);
{Reallocate memory}
SetBlock(ParasWeHave);
{Restore stack seg and ptr to original values}
inline(
$FA/ {CLI }
$A1/StackSeg/ {MOV AX,stackseg}
$8E/$D0/ {MOV SS,AX}
$8B/$26/StackPtr/ {MOV SP,stackptr}
$FB {STI }
);
{Put stack buffer back on stack}
Move(StackBuffer, Mem[StackSeg:StackPtr], succ(TopOfStack-StackPtr));
if ExecStatus <> 0 then
Error( ExecStatus );
end; {Invoke}